home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS03.ADF / ABasiCprogs / craps too.bas < prev    next >
BASIC Source File  |  1986-04-02  |  9KB  |  344 lines
  1. 1     rem *****  CRAPS  *****
  2. 2     rem By BOB HUTCHINSON
  3. 3     rem V 1.0
  4. 4     '
  5. 5     '
  6. 10    scnclr
  7. 11    penb 2:?at(50,50);" "
  8. 12    pena 1:draw(51,50)
  9. 13    draw(51,48)
  10. 14    draw(51,46)
  11. 15    draw(54,50):draw(54,48):draw(54,46)
  12. 16    dim c%(20)
  13. 17    sshape(50,45;56,51),c%
  14. 18    gshape(100,100),c%
  15. 19    scnclr
  16. 20    pena 1:penb 8
  17. 21    graphic 1
  18. 22    x=100:y=100
  19. 23    ?at(x,y);" DON'T "
  20. 24    ?at(x+4,y+8);" COME  "
  21. 25    a=5:b=50
  22. 26    d=-7:e=8
  23. 27    gosub 90
  24. 28    '
  25. 29    dim d%(290)
  26. 30    sshape(154,120;170,165),d%
  27. 31    gshape (50,50),d%
  28. 32    rem draw table
  29. 33    graphic 1
  30. 34    scnclr:pena 1
  31. 35    draw(-5,110 to 329,110)
  32. 36    peno 1:pena 1
  33. 37    circle(280,167),20
  34. 38    penb 8
  35. 39    ?at(255,152);"       "
  36. 40    ?at(255,160);"       "
  37. 41    ?at(255,168);" "
  38. 42    ?at(255,176);"  "
  39. 43    ?at(255,184);"    "
  40. 44    draw(300,110 to 300,162)
  41. 45    draw(100,186 to 284,186)
  42. 46    pena 8:paint(120,120),0
  43. 47    pena 1
  44. 48    circle(275,161),15
  45. 49    ?at(256,174);"  "
  46. 50    ?at(255,166);"  "
  47. 51    ?at(255,158);"     "
  48. 52    ?at(264,150);"   "
  49. 53    ?at(180,184);"PASS LINE"
  50. 54    draw(100,176 to 270,176)
  51. 55    draw(290,110 to 290,160)
  52. 56    '**************
  53. 57    draw(100,174 to 260,174)
  54. 58    ?at(120,172);"DON'T PASS BAR"
  55. 59    draw(100,164 to 260,164)
  56. 60    '*************
  57. 61    ?at(65,125);"  4   5   6   8   9      "
  58. 62    ?at(237,125);"10"
  59. 63    '*****
  60. 64    draw(100,110 to 100,185)
  61. 65    draw(70,128 to 260,128)
  62. 66    draw(70,116 to 260,116)
  63. 67    draw(70,114 to 260,114)
  64. 68    draw(70,110 to 70,130)
  65. 69    draw(70,130 to 260,130)
  66. 70    draw(260,110 to 260,173)
  67. 71    draw(133,110 to 133,114)                     
  68. 72    draw(133,116 to 133,128)
  69. 73    draw(166,110 to 166,130)
  70. 74    draw(197,110 to 197,114)
  71. 75    draw(197,116 to 197,128)
  72. 76    draw(230,110 to 230,130)
  73. 77    gshape(265,111),d%
  74. 78    gshape(240,166),c%
  75. 79    gshape(248,166),c%
  76. 80    gshape(282,135),c%
  77. 81    gshape(282,128),c%
  78. 82    draw(260,155 to 290,155)
  79. 83    '
  80. 84    draw(285,172 to 251,150 to 100,150)
  81. 85    ?at(145,145);" COME "
  82. 86    dim table%(3400)
  83. 87    sshape(0,110;301,190),table%
  84. 88    goto 100
  85. 90    '
  86. 91    for ac= a to b: rem across
  87. 92    for dn= d to e: rem down
  88. 93    n= pixel (x+ac,y+dn):pena n
  89. 94    draw(x+60+dn,y+70-ac)
  90. 95    next dn:next ac
  91. 96    return
  92. 100   rem this is the dice drawing routine only -- lines 100-130
  93. 101   scnclr
  94. 102   common pot
  95. 103   rgb 0,15,15,15
  96. 104   rem:borderoff rgb 1,15,15,15
  97. 105   pena 4
  98. 106   dim blank%(500)
  99. 107   sshape(42,42;99,94),blank%
  100. 108   box(50,50;90,85),1
  101. 109   draw(70,68)
  102. 110   dim d1%(300)
  103. 111   sshape(50,50;91,86),d1%
  104. 112   pena 2
  105. 113   draw(70,68)
  106. 114   draw(70,66 to 72,68 to 70,70 to 68,68 to 70,66)
  107. 115   draw(70,67 to 71,68 to 70,69 to 69,68)
  108. 116   dim spot%(100)
  109. 117   sshape(68,66;73,71),spot%
  110. 118   rem draw(70,40 to 70,95)
  111. 119   rem draw(40,68 to 100,68)
  112. 120   scnclr
  113. 121   pena 4
  114. 122   draw(70,42 to 42,68)
  115. 123   draw(70,42 to 98,68)
  116. 124   draw(to 70,93 to 42,68)
  117. 125   paint(80,60),1
  118. 126   dim d2%(500)
  119. 127   sshape(42,42;99,94),d2%
  120. 128   scnclr
  121. 129   rem THIS IS THE END OF THE           DICE DRAWING ROUTINE
  122. 130   '
  123. 150   rem this is the routine only
  124. 151   scnclr
  125. 152   rgb 0,15,9,10
  126. 153   pena 2:penb 1
  127. 154   ?at(40,50);"CLICK UP HERE TO ROLL DICE":?at(40,60);"CLICK IN PASSLINE OR DON'T PASS ":?AT(40,70);"TO BET"
  128. 155   gshape(0,110),table%
  129. 156   penb 2
  130. 157   pena 1:x=0:y=0
  131. 158   GOSUB 343
  132. 159   goto 307
  133. 160   '
  134. 161   gshape(x-20,y-10),blank%
  135. 162   penb 3:?at(40,10);"                              "
  136. 163   rem draw(120,118):stopTHIS           IS THE POS'N OF THE CENTER
  137. 164   p=0:q=0
  138. 165   p1=0:q1=0
  139. 166   x=-9:y=45
  140. 167   x1=-70:y1=15
  141. 168   gshape(x-28,y-26),d2%:rem D2% uses a different corner than D1%
  142. 169   gshape(x1-28,y1-26),d2%
  143. 170   sleep 1*10^5
  144. 171   gshape(x-28,y-26),blank%
  145. 172   gshape(x1-28,y1-26),blank%
  146. 173   if p=0 then x=x+20
  147. 174   if p1=0 then x1=x1+20
  148. 175   if p=1 then x=x-20
  149. 176   if p1=1 then x1=x1-20
  150. 177   if q=0 then y=y+20
  151. 178   if q1=0 then y1=y1+20
  152. 179   if q=1 then y=y-20
  153. 180   if q1=1 then y1=y1-20
  154. 181   gshape(x-20,y-18),d1%
  155. 182   gshape(x1-20,y1-18),d1%
  156. 183   sleep 1*10^5
  157. 184   if p=1 and x<80 and y>60 then 199
  158. 185   gshape(x1-28,y1-26),blank%
  159. 186   gshape(x-28,y-26),blank%
  160. 187   if p1=0 then x1=x1+20
  161. 188   if p=0 then x=x+20
  162. 189   if p=1 then x=x-20
  163. 190   if p1=1 then x1=x1-20
  164. 191   if x>270 then p=1
  165. 192   if x1>270 then p1=1
  166. 193   rem if x<-10 then p=0
  167. 194   if y>60 then q=1
  168. 195   if y1>60 then q1=1
  169. 196   if y<39 then q=0
  170. 197   if y1<39 then q1=0
  171. 198   goto 168
  172. 199   '
  173. 200   gshape(x-28,y-26),blank%
  174. 201   gshape(x1-28,y1-26),blank%
  175. 202   x=x-10
  176. 203   x1=x1-20
  177. 204   if y1<60 then y1=y1+20
  178. 205   gshape(x-28,y-26),d2%
  179. 206   gshape(x1-28,y1-26),d2%
  180. 207   sleep 1*10^5
  181. 208   gshape(x-28,y-26),blank%
  182. 209   gshape(x1-28,y1-26),blank%
  183. 210   sleep 1*10^5
  184. 211   x=x-10
  185. 212   if y1<60 then y1=y1+20
  186. 213   gshape(x-20,y-10),d1%
  187. 214   gshape(x1-20,y1-18),d1%
  188. 215   sleep 1*10^5
  189. 216   if x<120 then 218
  190. 217   goto 199
  191. 218   '
  192. 219   randomize
  193. 220   n1=int(rnd*6+1)
  194. 221   n=int(rnd*6+1)
  195. 222   if n=1 then gosub 236
  196. 223   if n=2 then gosub 239
  197. 224   if n=3 then gosub 242
  198. 225   if n=4 then gosub 246
  199. 226   if n=5 then gosub 250
  200. 227   if n=6 then gosub 255
  201. 228   x=x1:y=y1-8
  202. 229   if n1=1 then gosub 236
  203. 230   if n1=2 then gosub 239
  204. 231   if n1=3 then gosub 242
  205. 232   if n1=4 then gosub 246
  206. 233   if n1=5 then gosub 250
  207. 234   if n1=6 then gosub 255
  208. 235   goto 270
  209. 236   rem one spot
  210. 237   gosub 260
  211. 238   return
  212. 239   '
  213. 240   gosub 261
  214. 241   return
  215. 242   '
  216. 243   gosub 260
  217. 244   gosub 261
  218. 245   return
  219. 246   '
  220. 247   gosub 264
  221. 248   gosub 261
  222. 249   return
  223. 250   '
  224. 251   gosub 260
  225. 252   gosub 261
  226. 253   gosub 264
  227. 254   return
  228. 255   '
  229. 256   gosub 261
  230. 257   gosub 264
  231. 258   gosub 267
  232. 259   return
  233. 260   gshape(x-2,y+6),spot%:return
  234. 261   gshape(x-13,y+14),spot%:rem lower left
  235. 262   gshape(x+9,y-2),spot%:rem upper right
  236. 263   return
  237. 264   gshape(x-13,y-2),spot%:rem upper left
  238. 265   gshape(x+9,y+14),spot%:rem lower right
  239. 266   return
  240. 267   gshape(x-13,y+6),spot%:rem center left
  241. 268   gshape(x+9,y+6),spot%:rem center right
  242. 269   return
  243. 270   rem calculation for over/un
  244. 271   pena 1
  245. 272   A=n+n1
  246. 273   if pl=1 then 277
  247. 274   if pl=2 then 290
  248. 275   if dpl=1 then 293
  249. 276   if dpl=2 then 298
  250. 277   if a=7 or a=11 then 344
  251. 278   if a=2 or a=3 or a=12 then 357
  252. 279   pl=2:point=a:gosub 280:goto 288
  253. 280   pena 6
  254. 281   if a=4 then paint(82,120),1
  255. 282   if a=5 then paint(102,120),1
  256. 283   if a=6 then paint(142,120),1
  257. 284   if a=8 then paint(174,120),1
  258. 285   if a=9 then paint(202,120),1
  259. 286   if a=10 then paint(232,120),1
  260. 287   return
  261. 288   ask mouse x%,y%,b%:if b%<>4 then 288
  262. 289   goto 160
  263. 290   if a=7 then goto 357
  264. 291   if a=point then goto 344
  265. 292   goto 288
  266. 293   if a=7 or a=11 then 344
  267. 294   if a=2 or a=3 then 344
  268. 295   point=a:gosub 280
  269. 296   dpl=2
  270. 297   goto 300
  271. 298   if a=7 then goto 344:rem win
  272. 299   if a=point then 357: rem lose
  273. 300   ask mouse x%,y%,b%:if b%<>4 then 300
  274. 301   goto 160
  275. 302   gosub 343
  276. 303   goto 150
  277. 304   sleep 3*10^6
  278. 305   ?at(30,100)"MAKE A BET OR GOTO ANOTHER GAME"
  279. 306   pena 2:penb 1:?at(0,108);"QUIT                              QUIT":pena 1:penb 2
  280. 307   '
  281. 308   bet=0:pl=0:dpl=0
  282. 309   ask mouse x%,y%,b%
  283. 310   if b%<>4 then 309
  284. 311   penb 3:?at(30,100);"                               ":?at(0,108);"                                      "
  285. 312   if  y%>175 and dpl=0 then goto 318
  286. 313   if y%<175 and y%>165 and pl=0 then 327
  287. 314   rem  if x%>100 and x%<200 and y%>110 then gosub 640
  288. 315   rem quit  if y%<110 and y%>100 then chain "cstopsino",37,all
  289. 316   if y%<100 and pl=1 or dpl=1 then 368
  290. 317   goto 309
  291. 318   rem pass line
  292. 319   pl=1
  293. 320   bet=bet+1:pot=pot-1
  294. 321   pena 1:penb 8:?at(139,183);bet
  295. 322   gosub 343
  296. 323   peno 2:circle(150,180),7:pena 2:paint(155,180),1
  297. 324   if bet>4 then 368
  298. 325   sleep .25*10^6
  299. 326   goto 309
  300. 327   'dont pass line
  301. 328   dpl=1
  302. 329   bet=bet+1:pot=pot-1
  303. 330   pena 1:penb 8:?at(169,171);bet
  304. 331   GOSUB 343
  305. 332   peno 2:circle(180,168),7:pena 2:paint(184,168),1
  306. 333   if bet>4 then 368
  307. 334   sleep .25*10^6
  308. 335   goto 309
  309. 336   '
  310. 337   stop
  311. 338   b3=b3+1:pot=pot-1
  312. 339   GOSUB 343
  313. 340   sleep .25*10^6
  314. 341   return
  315. 342   '
  316. 343   pena 1:penb 2:?at(40,10);" YOU HAVE"POT"IN YOUR POCKET ":RETURN
  317. 344   '
  318. 345   sleep 1*10^6
  319. 346   if a=7 or a=11 then gosub 354
  320. 347   if pl>0 then gosub 355:goto 350
  321. 348   if dpl=1 then gosub 366:goto 150
  322. 349   gosub 355
  323. 350   for t=1 to bet*2:pot=pot+1:sleep 1*10^5:gosub 343:next
  324. 351   '
  325. 352   goto 150
  326. 353   x%=narrate (A$):return
  327. 354   A$ = translate$ ("thats a natural! "):goto 353
  328. 355   A$ = translate$ ("you win!"):goto 353
  329. 356   goto 150
  330. 357   '
  331. 358   sleep 1*10^6
  332. 359   if a=2 or a=3 or a=12 then gosub 364:goto 150
  333. 360   if a=7 then gosub 365:goto 150
  334. 361   gosub 366
  335. 362   goto 150
  336. 363   x%=narrate (A$):return
  337. 364   A$ = translate$(" craps! you lose."):goto 363
  338. 365   A$ = translate$ (" seven! Thats a loser."):goto 363
  339. 366   A$ = translate$("you lose!"):goto 363
  340. 367   '
  341. 368   A$=translate$("coming out"):gosub 353:goto 160
  342. 369   return
  343. 370   stop
  344.